emendas.areas.parlamentar <- read.csv("emendas_area_parlamentar.csv")
Vamos inicialmente ver quais dados temos:
emendas.areas.parlamentar %>% head()
## NOME_PARLAMENTAR Agricultura Assistência.Social
## 1 ABEL SALVADOR MESQUITA JUNIOR 0 0.00
## 2 ABELARDO CAMARINHA 0 11665.61
## 3 ABELARDO LUPION 0 206073.89
## 4 ABERLADO CAMARINHA 0 0.00
## 5 ACELINO POPO 0 925698.77
## 6 ACIR GURGACZ 0 88947.00
## Ciência.e.Tecnologia Comércio.e.Serviços Cultura Defesa.Nacional
## 1 0.0 0.00 0.00 3000.0
## 2 234296.3 0.00 0.00 0.0
## 3 0.0 12500.00 12500.00 0.0
## 4 0.0 0.00 0.00 0.0
## 5 0.0 44556.25 44556.25 0.0
## 6 0.0 0.00 0.00 920420.5
## Desporto.e.Lazer Direitos.da.Cidadania Gestão.Ambiental Indústria
## 1 0.0 0 0.0 0.0
## 2 0.0 0 234296.3 234296.3
## 3 0.0 0 0.0 0.0
## 4 0.0 0 0.0 0.0
## 5 252265.2 0 0.0 0.0
## 6 0.0 0 0.0 0.0
## Organização.Agrária Outros Saneamento Saúde Segurança.Pública Trabalho
## 1 0.0 3929 0.00 0.00 0 0
## 2 0.0 0 1274496.28 0.00 0 0
## 3 184792.6 0 132487.12 0.00 0 0
## 4 0.0 0 70769.45 0.00 0 0
## 5 925698.8 0 1546956.55 0.00 0 0
## 6 88947.0 0 0.00 1200.53 0 0
## Urbanismo
## 1 0.00
## 2 1508792.58
## 3 132487.12
## 4 70769.45
## 5 1546956.55
## 6 0.00
Vemos que cada observação é um parlamentar, onde a primeira coluna é o nome do mesmo, e as demais representam o investimento total que ele fez na área especificada.
Vamos ver como se comportam os dados das áreas:
melted.emendas.areas.parlamentar <- melt(emendas.areas.parlamentar, id=c("NOME_PARLAMENTAR"))
ggplot(melted.emendas.areas.parlamentar, aes(value)) +
geom_histogram() +
facet_wrap(~variable)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Como vemos, os dados são bastante enviesados, logo iremos utilizar a função log em cima dos mesmos:
melted.emendas.areas.parlamentar <- melted.emendas.areas.parlamentar %>%
mutate(
log.value = log(value)
)
ggplot(melted.emendas.areas.parlamentar, aes(log.value)) +
geom_histogram() +
facet_wrap(~variable, scales = "free")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 9877 rows containing non-finite values (stat_bin).
Grande parte dos dados parecem seguir uma distribuição normal, ou pelo menos próximo de uma normal.
Vamos remover os valores infinitos gerados pelo log:
melted.emendas.areas.parlamentar <- melted.emendas.areas.parlamentar %>%
mutate(
non.infinite.log.value = ifelse(is.infinite(log.value), 0, log.value)
)
emendas.area.2 <- dcast(select(melted.emendas.areas.parlamentar, -value, -log.value), NOME_PARLAMENTAR ~ variable)
## Using non.infinite.log.value as value column: use value.var to override.
emendas.area.2 <- emendas.area.2 %>%
filter(!is.na(NOME_PARLAMENTAR))
row.names(emendas.area.2) <- as.character(emendas.area.2$NOME_PARLAMENTAR)
Agora vamos reduzir a dimensão dos dados utilizando a técnica PCA:
principal.components <- prcomp(select(emendas.area.2, -NOME_PARLAMENTAR), scale = TRUE)
#kable(principal.components$rotation)
#biplot(principal.components, scale = 0)
#autoplot(principal.components, label = TRUE, label.size = 3, shape = FALSE)
autoplot(principal.components, label = TRUE, label.size = 3, shape = FALSE,
loadings = TRUE, loadings.colour = 'blue',
loadings.label = TRUE, loadings.label.size = 4)
Para melhorar a visualização dos vetores que representam as variáveis vamos retirar os nomes dos parlamentares:
autoplot(principal.components, shape = TRUE,
loadings = TRUE, loadings.colour = 'blue',
loadings.label = TRUE, loadings.label.size = 4)
Vemos 3 sentidos mais gerais em que os vetores apontam:
Além disso, conseguimos perceber 2 grandes grupos, um que tem valores de gestão ambiental, indústria e ciência e tecnologia mais altos e o outro são os demais, que estão mais condensados.
Vamos ver qual a porcentagem da variância explicada quando reduzimos as dimensões:
plot_pve <- function(prout){
pr.var <- prout$sdev ** 2
pve <- pr.var / sum(pr.var)
df = data.frame(x = 1:NROW(pve), y = cumsum(pve))
ggplot(df, aes(x = x, y = y)) +
geom_point(size = 3) +
geom_line() +
labs(x='Principal Component', y = 'Cumulative Proportion of Variance Explained')
}
plot_pve(principal.components)
Vemos que infelizmente ao reduzir a apenas 2 dimensões perdemos significativamente variância do dado original, visto que ficamos com pouco mais de 20%. Porém como o intuito também é agrupar os parlamentares, o ideal é que a redução seja a 2 dimensões.
Agora vamos reduzir as dimensões utilizando outra técnica chamada t-SNE:
tsne.dim = Rtsne(select(emendas.area.2, -NOME_PARLAMENTAR),
verbose = TRUE,
check_duplicates = FALSE,
scale = TRUE)
## Read the 861 x 17 data matrix successfully!
## Using no_dims = 2, perplexity = 30.000000, and theta = 0.500000
## Computing input similarities...
## Normalizing input...
## Building tree...
## - point 0 of 861
## Done in 0.12 seconds (sparsity = 0.143312)!
## Learning embedding...
## Iteration 50: error is 66.672004 (50 iterations in 0.39 seconds)
## Iteration 100: error is 62.935223 (50 iterations in 0.29 seconds)
## Iteration 150: error is 62.563264 (50 iterations in 0.30 seconds)
## Iteration 200: error is 62.500102 (50 iterations in 0.30 seconds)
## Iteration 250: error is 62.467622 (50 iterations in 0.29 seconds)
## Iteration 300: error is 0.781399 (50 iterations in 0.27 seconds)
## Iteration 350: error is 0.646534 (50 iterations in 0.28 seconds)
## Iteration 400: error is 0.612672 (50 iterations in 0.28 seconds)
## Iteration 450: error is 0.595451 (50 iterations in 0.28 seconds)
## Iteration 500: error is 0.590765 (50 iterations in 0.28 seconds)
## Iteration 550: error is 0.585186 (50 iterations in 0.28 seconds)
## Iteration 600: error is 0.580898 (50 iterations in 0.28 seconds)
## Iteration 650: error is 0.579417 (50 iterations in 0.28 seconds)
## Iteration 700: error is 0.578162 (50 iterations in 0.28 seconds)
## Iteration 750: error is 0.574989 (50 iterations in 0.28 seconds)
## Iteration 800: error is 0.574091 (50 iterations in 0.28 seconds)
## Iteration 850: error is 0.572351 (50 iterations in 0.28 seconds)
## Iteration 900: error is 0.571189 (50 iterations in 0.28 seconds)
## Iteration 950: error is 0.569621 (50 iterations in 0.28 seconds)
## Iteration 1000: error is 0.568153 (50 iterations in 0.28 seconds)
## Fitting performed in 5.76 seconds.
df = as.data.frame(tsne.dim$Y)
df$NOME_PARLAMENTAR = emendas.area.2$NOME_PARLAMENTAR
ggplot(df, aes(x = V1, y = V2, label = NOME_PARLAMENTAR)) +
geom_point(alpha = 0.8, size = 3, color = "tomato")
ggplot(df, aes(x = V1, y = V2, label = NOME_PARLAMENTAR)) +
geom_point(alpha = 0.2, size = 3, color = "tomato") +
geom_text(alpha = .7, size = 3, hjust = -.2)
Utilizando a técnica t-SNE, conseguimos identificar 4 grupos maiores, porém não é possível distinguir qual a relação entre os tipos de gasto e os grupos, iremos optar pelo PSA para continuar nossa análise.
Na atividade passada, propusemos 4 grupos utilizando a técnica kmeans e fizemos as seguintes anotações:
Vamos repetir o plot gerado acima para facilitar a análise:
autoplot(principal.components, shape = TRUE,
loadings = TRUE, loadings.colour = 'blue',
loadings.label = TRUE, loadings.label.size = 4)
Podemos notar o seguinte:
Como reduzimos as dimensões de 17 para 2, perdemos bastante variabilidade nos dados, mas mesmo assim conseguimos ver uma boa relação entre os grupos e variáveis descritas acima.
Se houvesse uma menor perda de variabilidade dos dados com a redução de dimensões, também seríamos capaz de afirmar que existe uma relação entre algumas variáveis, tais como Gestão Ambiental, Indústria e Ciência e Tecnologia, mas, como vimos acima, a perda foi considerável, logo, nada podemos afirmar sobre este assunto.
No final, apesar de toda a perda de variabilidade, podemos concluir que a redução de dimensionalidade foi satisfatória, visto a relação dos vetores e as anotações feitas a partir do kmeans no checkpoint passado.